home *** CD-ROM | disk | FTP | other *** search
/ Alles Voor Internet / Tout Pour Internet / alles voor internet.iso / MacInternet™ / Archive-tools / Hotlist2HTML Folder / Hotlist2HTML.f < prev    next >
Text File  |  1994-06-17  |  8KB  |  300 lines
  1. !!MP    inlines.f
  2.     program hotlis
  3. c
  4. c   Hotlist2HTML
  5. c
  6. c   Read the NCSA Mosaic (up from V. 1.0.2) Hotlist and generates
  7. c   a HTML page from it. Output is written to a user selectable file.
  8. c
  9. c   Compilation of this program requires the Language Systems Fortran 3.0
  10. c   compiler or a later Version, running under MPW 3.2.3.
  11. c   Furthermore, System 7 Toolbox routines are called. 
  12. c
  13. c   Lutz Weimann   Version 0.7     17.6.94
  14. c
  15.     implicit none
  16. c
  17. !!I        Standardfile.f
  18. c
  19.     integer outunit
  20.     parameter (outunit=20)
  21.     integer MaxListLength
  22.     parameter(MaxListLength=255)
  23. c
  24.     Integer ActualListLength, Mode
  25.     string*8 HTMLBrowser
  26.     integer*2 refnum, vRefNum, err
  27.     pointer /ptr/ menuh, urlsh, hotlisth
  28.     record /SFTypeList/ MyTypes
  29.     record /StandardFileReply/ ReplyRecord
  30.     string*255 HotlistName, thestring
  31.     string*255 Menu(MaxListLength), URLs(MaxListLength)
  32. c
  33.     call InitialAboutBox(Mode)
  34. c
  35.     MyTypes.OSTy(0)='HOTL'
  36.     MyTypes.OSTy(1)='HLST'
  37.     Call StandardGetFile(nil,Int2(2),MyTypes,ReplyRecord)
  38.     if (.not.ReplyRecord.sfGood) stop 'Hotlist selection canceled!'
  39.     HotlistName = ReplyRecord.sfFile.name
  40. c
  41.     refnum = FSpOpenResfile(ReplyRecord.sfFile,Int1(1))
  42.     if (ResError().ne.0) stop 'OpenResfile: Cannot open Hotlist!'
  43. c
  44.     call UseResFile(refnum)
  45.     if (ResError().ne.0) stop 'UseResFile failed!'
  46. c
  47.     if (ReplyRecord.sfType.F .eq. 'HOTL') then
  48. c
  49.         HTMLBrowser='Mosaic'
  50.         thestring = 'Menu'
  51.         menuh = GetNamedResource('STR#',thestring)
  52.         if (ResError().ne.0) stop 'Cant find STR# Resource Menu!'
  53. c
  54.         thestring = 'URLs'
  55.         urlsh = GetNamedResource('STR#',thestring)
  56.         if (ResError().ne.0) stop 'Cant find STR# Resource URLs!'
  57. c
  58.         call ReadInMosaicHotlist(%val(menuh^.p), %val(urlsh^.p),
  59.      $                           MaxListLength, Menu, URLs,
  60.      $                           ActualListLength)
  61. c
  62.     else if (ReplyRecord.sfType.F .eq. 'HLST') then
  63. c
  64.         HTMLBrowser='MacWeb'
  65.         thestring = 'Hotlist'
  66.         hotlisth = GetNamedResource('STR#',thestring)
  67.         if (ResError().ne.0) stop 'Cant find STR# Resource Hotlist!'
  68. c
  69.         call ReadInMacWebHotlist(%val(hotlisth^.p), MaxListLength,  
  70.      $                           Menu, URLs, ActualListLength)
  71. c
  72.     else
  73.         stop 'Input file has an unknown type!'
  74.     endif
  75. c
  76.     if (Mode.eq.0) Call HotlistSort(ActualListLength, Menu, URLs)
  77. c
  78.     call F_SetDefaultFileName (HotlistName//'.html')
  79.     open (outunit,file=*'Save HTML page as:',status='new',
  80.      $    creator='ttxt')
  81. c
  82.     call WriteHTMLfile(outunit, HotlistName, ActualListLength,
  83.      $                 Menu, URLs, HTMLBrowser)
  84. c
  85.     close(outunit)
  86.      call CloseResFile(refnum)
  87.     if (ResError().ne.0) stop 'CloseResFile failed!'
  88.     end
  89. c
  90. c
  91.     subroutine ReadInMosaicHotlist(Menu, URLs, MaxListLength,
  92.      $                             MenuStor, URLsStor, ActListLength)
  93.     implicit none
  94.     integer*1 Menu(*), URLs(*)
  95.     integer MaxListLength, ActListLength
  96.     string*255 MenuStor(MaxListLength), URLsStor(MaxListLength)
  97. c
  98.     integer numMenu, numURLs, ptrMenu, ptrURLs, lMenu, lURLs,
  99.      $      i, j, temp1, temp2
  100.     character*255 CharMenuBuf, CharURLsBuf
  101.     integer*1 IntMenuBuf(255), IntURLsBuf(255)
  102.     equivalence (CharMenuBuf,IntMenuBuf), (CharURLsBuf,IntURLsBuf)
  103.     character*255 Message
  104. c
  105.     
  106.     temp1 = Menu(1)
  107.     if (temp1.lt.0) temp1=256+temp1
  108.     temp2 = Menu(2)
  109.     if (temp2.lt.0) temp2=256+temp2
  110.     numMenu = temp1*256+temp2
  111.     temp1 = URLs(1)
  112.     if (temp1.lt.0) temp1=256+temp1
  113.     temp2 = URLs(2)
  114.     if (temp2.lt.0) temp2=256+temp2
  115.     numURLs = temp1*256+temp2
  116.     if (numMenu.ne.numURLs) then
  117.         Message = 'Different number of menuitems and URLs found.'//
  118.      $            'I generate a list of the lower number length'
  119.         call AlertBox(Message)
  120.     endif
  121.     ActListLength = min(numMenu, numURLs)
  122.     if (ActListLength.gt.MaxListLength) then
  123.         write(Message,1001) ActListLength, MaxListLength
  124.         call AlertBox(Message)
  125.         ActListLength = MaxListLength
  126.     endif
  127.     ptrMenu = 3
  128.     ptrURLs = 3
  129.     do i=1,ActListLength
  130.         lMenu = Menu(ptrMenu)
  131.         if (lMenu.lt.0) lMenu=256+lMenu
  132.         do j=1,lMenu
  133.             IntMenuBuf(j) = Menu(ptrMenu+j)
  134.         enddo
  135.         ptrMenu = ptrMenu+lMenu+1
  136.         MenuStor(i) = CharMenuBuf(1:lMenu)
  137.         lURLs = URLs(ptrURLs)
  138.         if (lURLs.lt.0) lURLs=256+lURLs
  139.         do j=1,lURLs
  140.             IntURLsBuf(j) = URLs(ptrURLs+j)
  141.         enddo
  142.         ptrURLs = ptrURLs+lURLs+1
  143.         URLsStor(i) = CharURLsBuf(1:lURLs)
  144.     enddo
  145.     return
  146. c
  147. 1001    format('Your Hotlist has ',a,' entries - too much for me.',
  148.      $         'Only the first ',a,' entries are converted to HTML')
  149.     end
  150. c
  151. c
  152.     subroutine ReadInMacWebHotlist(Hotlist, MaxListLength,
  153.      $                             MenuStor, URLsStor, ActListLength)
  154.     implicit none
  155.     integer*1 Hotlist(*)
  156.     integer MaxListLength, ActListLength
  157.     string*255 MenuStor(MaxListLength), URLsStor(MaxListLength)
  158. c
  159.     integer numItems, ptrMenu, ptrURLs, lMenu, lURLs,
  160.      $      i, j, temp1, temp2
  161.     character*255 CharMenuBuf, CharURLsBuf
  162.     integer*1 IntMenuBuf(255), IntURLsBuf(255)
  163.     equivalence (CharMenuBuf,IntMenuBuf), (CharURLsBuf,IntURLsBuf)
  164.     character*255 Message
  165. c
  166.     temp1 = Hotlist(1)
  167.     if (temp1.lt.0) temp1=256+temp1
  168.     temp2 = Hotlist(2)
  169.     if (temp2.lt.0) temp2=256+temp2
  170.     numItems = temp1*256+temp2
  171.     ActListLength = NumItems/2
  172.     if (ActListLength*2.ne.NumItems) then
  173.         Message = 'Inconsistent number of menu titles and URLs '//
  174.      $            'in the MacWeb Hotlist. Something may be '//
  175.      $            'missed within the HTML output.'
  176.         call AlertBox(Message)
  177.     endif
  178.     if (ActListLength.gt.MaxListLength) then
  179.         write(Message,1001) ActListLength, MaxListLength
  180.         call AlertBox(Message)
  181.         ActListLength = MaxListLength
  182.     endif
  183.     ptrMenu = 3
  184.     do i=1,ActListLength
  185.         lMenu = Hotlist(ptrMenu)
  186.         if (lMenu.lt.0) lMenu=256+lMenu
  187.         do j=1,lMenu
  188.             IntMenuBuf(j) = Hotlist(ptrMenu+j)
  189.         enddo
  190.         ptrURLs = ptrMenu+lMenu+1
  191.         MenuStor(i) = CharMenuBuf(1:lMenu)
  192.         lURLs = Hotlist(ptrURLs)
  193.         if (lURLs.lt.0) lURLs=256+lURLs
  194.         do j=1,lURLs
  195.             IntURLsBuf(j) = Hotlist(ptrURLs+j)
  196.         enddo
  197.         ptrMenu = ptrURLs+lURLs+1
  198.         URLsStor(i) = CharURLsBuf(1:lURLs)
  199.     enddo
  200.     return
  201. c
  202. 1001  format('Your Hotlist has ',a,' entries - too much for me.',
  203.      $         'Only the first ',a,' entries are converted to HTML')
  204.     end
  205. c
  206. c
  207.     subroutine WriteHTMLfile(outunit, HotlistFileName, ActualListLength,
  208.      $                       Menu, URLs, HTMLBrowser)
  209.     implicit none
  210.     integer outunit
  211.     string*255 HotlistFileName
  212.     integer ActualListLength
  213.     string*255 Menu(ActualListLength), URLs(ActualListLength)
  214.     string*8 HTMLBrowser
  215. c
  216.     string*255 Message
  217.     character*9 datestring
  218.     integer i
  219. c
  220.     write(outunit,1001) HotlistFileName, HotlistFileName
  221.     do i=1,ActualListLength
  222.         write(outunit,1002) URLs(i), Menu(i)
  223.     enddo
  224.     call date(datestring)
  225.     write(outunit,1003) HTMLBrowser, HotlistFileName, datestring
  226.     return
  227. c
  228. 1001  format('<TITLE>',a,'</TITLE>',/,'<H1>',a,'</H1>','<UL>')
  229. 1002  format('<LI> <A HREF= "',a,'">',a,'</A>')
  230. 1003  format('</UL>',/,'<ADDRESS>Generated from ',a,'-Hotlist ',a,
  231.      $       ' at ',a,'</ADDRESS>',/)
  232.     end
  233. c
  234. c
  235.     Subroutine HotlistSort(ActualListLength, Menu, URLs)
  236.     implicit none
  237. c
  238. c    A simple (and not most quick) sort routine.
  239. c    Sorts the Hotlist lexically according to the names of the MenuItems.
  240. c
  241.     integer ActualListLength
  242.     string*255 Menu(ActualListLength), URLs(ActualListLength)
  243. c
  244.     string*255 MenuLow, URLsLow
  245.     integer i,j,indexLow
  246. c
  247.     do i=1,ActualListLength-1
  248.         MenuLow = Menu(i)
  249.         indexLow = i
  250.         do j=i+1,ActualListLength
  251.             if (Menu(j).lt.MenuLow) then
  252.                 MenuLow = Menu(j)
  253.                 indexLow = j
  254.             endif
  255.         enddo
  256.         URLsLow = URLs(indexLow)
  257.         Menu(indexLow) = Menu(i)
  258.         URLs(indexLow) = URLs(i)
  259.         Menu(i) = MenuLow
  260.         URLs(i) = URLsLow
  261.     enddo
  262.     return
  263.     end
  264. c
  265. c
  266.     Subroutine InitialAboutBox(Mode)
  267.     implicit none
  268.     integer Mode
  269. c
  270. !!I    Dialogs.f
  271. !!I    Events.f
  272. c
  273.     integer*2 AboutDialogID
  274.     parameter (AboutDialogID=32002)
  275. c
  276.     record /EventRecord/ theEvent
  277.     record /DialogRecord/ AboutDialog
  278.     record /DialogPtr/ AboutDialogPtr
  279.     integer*2 itemhit
  280.     logical status
  281. c
  282.     call InitDialogs(nil)
  283.     AboutDialogPtr = GetNewDialog(AboutDialogID, %ref(AboutDialog), -1)
  284. c
  285.     do while (.not.GetNextEvent(mDownMask,theEvent))
  286.         if (GetNextEvent(updateMask,theEvent)) then
  287.             if (.not.IsDialogEvent(theEvent)) cycle
  288.             status = DialogSelect(theEvent,%ref(AboutDialogPtr),%ref(itemhit))
  289.         endif
  290.     enddo
  291. C   Mode = 0: Shift key not pressed;  Mode=1: Shift key pressed
  292.     Mode = IAND(theEvent.modifiers,Z'200')
  293.     if (Mode.ne.0) Mode=1
  294.     call DisposDialog(AboutDialogPtr)
  295.     return
  296.     end
  297.     
  298.     
  299.     
  300.